home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / self / contrib.lha / contrib / self-mode / self-mode.shar / self-mode.el < prev    next >
Encoding:
Text File  |  1993-07-24  |  9.8 KB  |  302 lines
  1. ;; Self mode editing commands for Emacs, a first cut...
  2. ;; Mar 11, 1992 Stuart Williams, williams@cs.washington.edu
  3. ;; Let me know if you fix stuff.
  4.  
  5. ;; Extended by Craig Chambers, Jan 30, 1993.
  6. ;;   Indent statement continuation lines
  7. ;;   Indent comments and multi-line comments (sort of)
  8.  
  9. ;; Extended by Urs Hoelzle, March 21, 1993.
  10. ;;   Added Lucid emacs highlighting (thanks to Lars Bak)
  11.  
  12. ;;
  13. ;; Hacked by Michael Richardson <mcr@physics.carleton.ca> to interact
  14. ;; with self.el, an inferior self mode.
  15. ;;  - Added M-C-x to do send-self-object.
  16. ;;  - Added beginning-of-object/end-of-object for above.
  17. ;;  - Also added backward-object/forward-object (not currently bound
  18. ;;    to any specific key. I tend to bind them to function keys..)
  19. ;;  - Stuff it into RCS.
  20.  
  21. ;; To do:
  22. ;; - Parsing for indentation is currently done starting at the top of the
  23. ;;   whole file (yuck)!  It should start parsing somewhere closer.
  24. ;; - Indentation is absolute from parsing the whole file and the left margin,
  25. ;;   it should be relative to the enclosing block of code.
  26. ;; - right bracket and parethesis should only call self-indent if they're
  27. ;;   at the beginning of a line, not at the end.
  28. ;; - A second tab in a row could be smarter and insert a tab
  29.  
  30. ;
  31. ; $Id: self-mode.el,v 1.1 1993/05/14 21:11:48 richards Rel $
  32. ; 
  33. ; $Log: self-mode.el,v $
  34. ; Revision 1.1  1993/05/14  21:11:48  richards
  35. ; Initial revision
  36. ;
  37. ;
  38.  
  39. (provide 'self-mode)
  40.  
  41. (defvar self-mode-abbrev-table nil
  42.   "Abbrev table for use in self-mode buffers.")
  43. (define-abbrev-table 'self-mode-abbrev-table ())
  44.  
  45. (defvar self-mode-map ()
  46.   "Keymap used in Self mode.")
  47.  
  48. (defun self-mode-commands (map) 
  49.   "Adds the self commands to a keymap."
  50.   (define-key map "\177" 'backward-delete-char-untabify)
  51.   (define-key map "\t" 'self-tab-indent)
  52.   (define-key map "\C-j" 'newline-and-indent)
  53.   (define-key map "\M-\C-x" 'self-send-object)
  54.   ;; uncomment the next 4 lines to turn off automatic indentation
  55.   (define-key map "(" 'electric-self-brace)
  56.   (define-key map ")" 'electric-self-brace)
  57.   (define-key map "[" 'electric-self-brace)
  58.   (define-key map "]" 'electric-self-brace))
  59.  
  60. (if self-mode-map
  61.     ()
  62.   (progn
  63.     (setq self-mode-map (make-sparse-keymap))
  64.     (self-mode-commands self-mode-map)))
  65.  
  66. (defvar self-mode-syntax-table nil
  67.   "Syntax table in use in Self-mode buffers.")
  68.  
  69. (if self-mode-syntax-table
  70.     ()
  71.   (setq self-mode-syntax-table (make-syntax-table))
  72.   (modify-syntax-entry ?\( "()  " self-mode-syntax-table)
  73.   (modify-syntax-entry ?\) ")(  " self-mode-syntax-table)
  74.   (modify-syntax-entry ?\[ "(]  " self-mode-syntax-table)
  75.   (modify-syntax-entry ?\] ")[  " self-mode-syntax-table)
  76.   (modify-syntax-entry ?\| "$|  " self-mode-syntax-table)
  77.  
  78.   ;; treat double quote as string,
  79.   ;; since it can't be both comment start and end
  80.   (modify-syntax-entry ?\" "\"   " self-mode-syntax-table)
  81.  
  82.   ;; apostrophe is used for strings
  83.   (modify-syntax-entry ?\' "\"   " self-mode-syntax-table)
  84.  
  85.   ;; space, tab, newline, and formfeed are whitespace:
  86.   (modify-syntax-entry ?   "    " self-mode-syntax-table)
  87.   (modify-syntax-entry ?\t "    " self-mode-syntax-table)
  88.   (modify-syntax-entry ?\n "    " self-mode-syntax-table)
  89.   (modify-syntax-entry ?\f "    " self-mode-syntax-table)
  90.  
  91.   (modify-syntax-entry ?\\ "\\  " self-mode-syntax-table)
  92.  
  93.   (modify-syntax-entry ?+ "." self-mode-syntax-table)
  94.   (modify-syntax-entry ?- "." self-mode-syntax-table)
  95.   (modify-syntax-entry ?= "." self-mode-syntax-table)
  96.   (modify-syntax-entry ?% "." self-mode-syntax-table)
  97.   (modify-syntax-entry ?< "." self-mode-syntax-table)
  98.   (modify-syntax-entry ?> "." self-mode-syntax-table)
  99.   (modify-syntax-entry ?& "." self-mode-syntax-table))
  100.  
  101. (defconst self-indent-level 4
  102.   "*Indentation of Self statements with respect to containing block.")
  103.  
  104. (defconst self-continuation-indent-level 4
  105.   "*Indentation of Self statement continuations with respect to statement start.")
  106.  
  107. (defun self-mode ()
  108.   "Major mode for editing Self code."
  109.   (interactive)
  110.   (kill-all-local-variables)
  111.   (use-local-map self-mode-map)
  112.   (setq major-mode 'self-mode)
  113.   (setq mode-name "Self")
  114.   (self-mode-variables)
  115.   (run-hooks 'self-mode-hook))
  116.  
  117. (defun self-mode-variables ()
  118.   (setq local-abbrev-table self-mode-abbrev-table)
  119.   (set-syntax-table self-mode-syntax-table)
  120.   (make-local-variable 'paragraph-start)
  121.   (setq paragraph-start (concat "^$\\|" page-delimiter))
  122.   (make-local-variable 'paragraph-separate)
  123.   (setq paragraph-separate paragraph-start)
  124.   (make-local-variable 'paragraph-ignore-fill-prefix)
  125.   (setq paragraph-ignore-fill-prefix t)
  126.   (make-local-variable 'indent-line-function)
  127.   (setq indent-line-function 'self-tab-indent)
  128.   (make-local-variable 'require-final-newline)
  129.   (setq require-final-newline t))
  130.  
  131.  
  132. (defun self-tab-indent ()
  133.   "Indent current line as Self code, even if an empty line."
  134.   (interactive)
  135.   (let ((indent-column (self-indent-line))) ; how far should we indent
  136.     (if (and (numberp indent-column)
  137.          (< (current-column) indent-column)) ; move cursor to right only
  138.     (move-to-column indent-column))))
  139.  
  140. (defun self-indent-line ()
  141.   "Indent current line as Self code."
  142.   (interactive)
  143.   (let ((indent-size (calculate-self-indent)))
  144.     (if (numberp indent-size)        ; else don't indent
  145.     (save-excursion
  146.       (beginning-of-line)
  147.       (skip-chars-forward " \t")
  148.       (if (/= (current-column) indent-size)
  149.           (progn        ; don't change unless we have to
  150.         (delete-horizontal-space)
  151.         (indent-to-column indent-size)))))
  152.     indent-size))
  153.  
  154. (defun self-indent-region (start end)
  155.   "Indent the current region as Self code."
  156.   (interactive "r")
  157.   (save-excursion
  158.     (let ((end-marker (copy-marker end)))
  159.       (goto-char start)
  160.       (while (< (point) (marker-position end-marker))
  161.     (forward-line)
  162.     (self-indent-line)))))
  163.  
  164. (defun self-indent-buffer ()
  165.   "Indent the current buffer as Self code."
  166.   (interactive)
  167.   (save-excursion
  168.     (self-indent-region (point-min) (point-max))))
  169.  
  170. (defun calculate-self-indent ()
  171.   "Calculate correct indentation for a line of Self code.
  172. Returns an integer or nil if inside a string."
  173.   (save-excursion
  174.     (beginning-of-line)
  175.     (skip-chars-forward " \t")
  176.     (let (state paren-depth containing-sexp in-comment in-string)
  177.       (setq state (parse-partial-sexp 1 (point))) ;; this should *not* be 1
  178.  
  179.       (setq paren-depth (nth 0 state))
  180.       (setq containing-sexp (nth 1 state))
  181.       (setq in-comment (nth 3 state))    ;; documentation has these two backwards
  182.       (setq in-string (nth 4 state))
  183.  
  184.       (cond
  185.        (in-string
  186.        ;; If inside string return nil (don't indent);
  187.     nil)
  188.  
  189.        (in-comment
  190.     ;; If inside comment indent equal to enclosing statement, plus 1 to
  191.     ;; skip the enclosing quote char
  192.     ;; (really should indent equal to the first char after the quote,
  193.     ;;  to line up text nicely)
  194.     (1+ (* self-indent-level paren-depth)))
  195.  
  196.        ((null containing-sexp)
  197.     ;; Line is at top level.
  198.     ;; Because of paren-counting at top-level, never have a continuation
  199.     ;; line at the top-level.
  200.     ;; No indentation at top-level.
  201.     0)
  202.        
  203.        ((or
  204.      (looking-at ")")
  205.      (looking-at "]")
  206.      (looking-at "|[ \t]*)")
  207.      (looking-at "|[ \t]*]"))
  208.     ;; line starts a statement, and should back up indentation, too
  209.     (* self-indent-level (1- paren-depth)))
  210.     
  211.        (t
  212.     ;; a nested line; check whether it starts a statement or continues one
  213.     (cond ((self-starts-statement containing-sexp)
  214.            ;; starts statement
  215.            (* self-indent-level paren-depth))
  216.           (t
  217.            ;; continues statement; indent some more
  218.            (+ (* self-indent-level paren-depth)
  219.           self-continuation-indent-level))))))))
  220.  
  221. (defun self-starts-statement (lim)
  222.   (save-excursion
  223.     (catch 'done
  224.       (while t
  225.     (skip-chars-backward " \t\n\f" lim)
  226.     (if (<= (point) lim) (throw 'done t))
  227.     (backward-char)
  228.     (cond ((looking-at "\"")
  229.            (progn
  230.          (search-backward "\"" lim 'move-if-fail)
  231.          (if (<= (point) lim) (throw 'done t))))
  232.           (t (throw 'done
  233.             (or
  234.              (looking-at "\\.")
  235.              (looking-at "(")
  236.              (looking-at "\\[")
  237.              (looking-at "|")))))))))
  238.  
  239. (defun electric-self-brace (arg)
  240.   "Insert character and correct line's indentation."
  241.   (interactive "P")
  242.   (insert last-command-char)        ; insert arg, in a way that won't blink
  243.   (self-indent-line)            ; indent it
  244.   (delete-char -1)            ; delete and reinsert arg so it blinks
  245.   (self-insert-command (prefix-numeric-value arg)))
  246.  
  247. (defun end-of-object ()
  248.   "Move the point to the spot where the object ends."
  249. ; I assume that with normal formatting, this is a line that has
  250. ; just a (|) on it.
  251.   (interactive)
  252.   (beginning-of-line)
  253.   (while (and (< (point) (point-max))
  254.           (not (looking-at ")"))
  255.           (not (looking-at "]"))
  256.           (not (looking-at "|[ \t]*)"))
  257.           (not (looking-at "|[ \t]*]")))
  258.     (forward-line)
  259.     (beginning-of-line))
  260.   (if (< (point) (point-max)) (forward-line)))
  261.  
  262. (defun beginning-of-object ()
  263.   "Move the point to the spot where the object begins."
  264. ; We do this by going upwards, looking for the end of previous object.
  265. ; An alternative way is to look for a line that doesn't start with a space.
  266. ; Time will tell what the better method is.
  267.   (interactive)
  268.   (beginning-of-line)
  269.   (while (and (> (point) (point-min))
  270.           (not (looking-at ")"))
  271.           (not (looking-at "]"))
  272.           (not (looking-at "|[ \t]*)"))
  273.           (not (looking-at "|[ \t]*]")))
  274.     (forward-line -1)
  275.     (beginning-of-line))
  276. ; don't go forward at the top.
  277.   (if (> (point) (point-min)) (forward-line)))
  278.  
  279. (defun forward-object (&optional num)
  280.   "moves forward in the file by arg objects"
  281.   (interactive "p")
  282.   (if (not num) (setq num 1))
  283.   (while (> num 0)
  284.     (end-of-object)
  285.     (setq num (- num 1))))
  286.   
  287. (defun backward-object (&optional num)
  288.   "moves backward in the file by arg objects"
  289.   (interactive "p")
  290.   (if (not num) (setq num 1))
  291.   (forward-line -1)
  292.   (while (> num 0)
  293.     (beginning-of-line)
  294.     (while (or (looking-at ")")
  295.            (looking-at "]")
  296.            (looking-at "|[ \t]*)")
  297.            (looking-at "|[ \t]*]"))
  298.       (forward-line -1))
  299.     (beginning-of-object)
  300.     (setq num (- num 1))))
  301.  
  302.